{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit LocalProcessTransmitter;

interface

uses
  Classes, SysUtils, Transmitter, Windows, JwaWinBase, MiscUtils;

type
  TLocalProcessTransmitter = class(TTransmitter)
  private
    FExecutableFileName: String;
    FCommandLineArguments: String;
    FStderrFileName: String;

    FOutPipeCreated: Boolean;
    FOutReadPipe: THandle;
    FOutReadStream: THandleStream;

    FInPipeCreated: Boolean;
    FInWritePipe: THandle;
    FInWriteStream: THandleStream;

    FProcessCreated: Boolean;
    FProcess: THandle;
    procedure ConnectIfNeeded;
    function ProcessTerminated: Boolean;
  public
    constructor Create(const ExecutableFileName, CommandLineArguments,
      StderrFileName: String);
    destructor Destroy; override;
    function Send(Input: TStream): TStream; override;
    procedure Disconnect; override;
  end;

implementation

const
  PIPE_BUFFER_SIZE = 4096;

{ TLocalProcessTransmitter }

procedure MakeInheritable(h: THandle);
begin
  if not SetHandleInformation(h, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT) then
    raise Exception.Create('SetHandleInformation failed.');
end;

procedure TLocalProcessTransmitter.ConnectIfNeeded;
var
  pi: TProcessInformation;
  si: TStartupInfoW;
  CommandLine: UnicodeString;
  StderrStream: TUnicodeFileStream;
  OutWritePipe, InReadPipe: THandle;
begin
  if ProcessTerminated then
    Disconnect;

  if not FProcessCreated then
  begin
    try
      {$HINTS OFF}
      FOutPipeCreated := CreatePipe(FOutReadPipe, OutWritePipe, nil, PIPE_BUFFER_SIZE);
      FInPipeCreated := CreatePipe(InReadPipe, FInWritePipe, nil, PIPE_BUFFER_SIZE);
      {$HINTS ON}
      try
        if not (FOutPipeCreated and FInPipeCreated) then
          raise Exception.Create('CreatePipe failed.');

        MakeInheritable(OutWritePipe);
        MakeInheritable(InReadPipe);

        StderrStream := TUnicodeFileStream.CreateNew(FStderrFileName, TRUE);
        try
          MakeInheritable(StderrStream.Handle);

          {$HINTS OFF}
          FillChar(si, SizeOf(si), 0);
          {$HINTS ON}
          si.cb := SizeOf(si);
          si.hStdInput := InReadPipe;
          si.hStdOutput := OutWritePipe;
          si.hStdError := StderrStream.Handle;
          si.wShowWindow := SW_HIDE;
          si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW or STARTF_FORCEOFFFEEDBACK;

          CommandLine := UTF8Decode(Format('"%s" %s', [FExecutableFileName, FCommandLineArguments]));

          UniqueString(CommandLine); { CreateProcessW wants writable lpCommandLine buffer }
          {$HINTS OFF}
          FProcessCreated := CreateProcessW(PWideChar(UTF8Decode(FExecutableFileName)),
            PWideChar(CommandLine), nil, nil, TRUE, 0, nil, nil, si, pi);
          {$HINTS ON}
          if not FProcessCreated then
            raise Exception.Create('CreateProcess failed.');

          CloseHandle(pi.hThread);
          FProcess := pi.hProcess;
        finally
          StderrStream.Free;
        end;
      finally
        if FOutPipeCreated then
          CloseHandle(OutWritePipe);
        if FInPipeCreated then
          CloseHandle(InReadPipe);
      end;

      FInWriteStream := THandleStream.Create(FInWritePipe);
      FOutReadStream := THandleStream.Create(FOutReadPipe);
    except
      Disconnect;
      raise;
    end;
  end;
end;

procedure TLocalProcessTransmitter.Disconnect;
begin
  FreeAndNil(FOutReadStream);
  if FOutPipeCreated then
  begin
    CloseHandle(FOutReadPipe);
    FOutPipeCreated := FALSE;
  end;

  FreeAndNil(FInWriteStream);
  if FInPipeCreated then
  begin
    CloseHandle(FInWritePipe);
    FInPipeCreated := FALSE;
  end;

  if FProcessCreated then
  begin
    WaitForSingleObject(FProcess, INFINITE);
    CloseHandle(FProcess);
    FProcessCreated := FALSE;
  end;
end;

function TLocalProcessTransmitter.ProcessTerminated: Boolean;
begin
  Result := FProcessCreated and (WaitForSingleObject(FProcess, 0) <> WAIT_TIMEOUT);
end;

constructor TLocalProcessTransmitter.Create(const ExecutableFileName,
  CommandLineArguments, StderrFileName: String);
begin
  inherited Create;
  FExecutableFileName := ExecutableFileName;
  FCommandLineArguments := CommandLineArguments;
  FStderrFileName := StderrFileName;
end;

destructor TLocalProcessTransmitter.Destroy;
begin
  Disconnect;
  inherited;
end;

function TLocalProcessTransmitter.Send(Input: TStream): TStream;
var
  ResponseSize: Int64;
  SizeStream: TMemoryStream;
begin
  Result := nil;
  try
    ConnectIfNeeded;

    WriteStreamInt64(FInWriteStream, Input.Size);
    FInWriteStream.CopyFrom(Input, 0);

    SizeStream := TMemoryStream.Create;
    try
      CopyStreamPart(FOutReadStream, SizeStream, SizeOf(ResponseSize));
      SizeStream.Seek(0, soFromBeginning);
      ResponseSize := ReadStreamInt64(SizeStream);
    finally
      SizeStream.Free;
    end;

    if ResponseSize < 1 then
      raise Exception.CreateFmt('Invalid response size: %d.', [ResponseSize]);

    Result := TMemoryStream.Create;
    Result.Size := ResponseSize; { optimization }
    CopyStreamPart(FOutReadStream, Result, ResponseSize);

    Result.Seek(0, soFromBeginning);
    if not ReadStreamBoolean(Result) then
      raise ECommandFailed.Create;
  except
    Result.Free;
    raise;
  end;
end;

end.

